home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Thomas / MacGambit⁄Thomas / MacGambit⁄Thomas Sources / Reference Notes / how-to-use-utilities.scm < prev    next >
Encoding:
Text File  |  1995-03-15  |  4.9 KB  |  122 lines  |  [TEXT/gamI]
  1. ;;;This file contains some sample applications of functions provided
  2. ;;;in Utilities.scm, since the documentation is pretty slim.
  3. ;;;
  4. ;;;You must first load Utilities.scm!!!!
  5. ;;;
  6.  
  7.  
  8. ;;;Please look at the menus, and someone will be by to take your order...
  9. ;;;Here is some sample code to demonstrate how menu stuff is set up
  10. ;;;This adds a menu pick on the Special menu of MacGambit, "Switch to
  11. ;;;other menu" which brings up the menu built up in the function
  12. ;;;nuke-menus.  Picking "Quit" on the file menu when this set of menus
  13. ;;;is up will call restore-menus and return you to the familiar menus
  14. ;;;One word of caution - menu ids are not recycled, and since we're starting
  15. ;;;at 145 and can only go up to 255, you can only play this game a limited
  16. ;;;number of times before you get an error and can't switch to the new menus
  17. ;;;anymore.  It is always possible to switch to the old menus, just type
  18. ;;;(restore-menus 42)
  19.  
  20. (define $menufuns #t)
  21.  
  22. (define (restore-menus dummy)
  23.   (mac#clearmenubar)
  24.   (add-old-menu "Apple" 128)            ;item 0
  25.   (add-old-menu "File" 129)             ;item 1
  26.   (add-old-menu "Edit" 130)             ;item 2
  27.   (add-old-menu "Search" 131)            ;item 3
  28.   (add-old-menu "Command" 132)             ;item 4
  29.   (add-old-menu "Windows" 133)             ;item 5
  30. ;  (add-old-menu "Special" 134)             ;item 6
  31.   (set! current-ids #f)
  32.   (mac#insertmenu (mac#getmenu 134) 0)
  33.   (set! current-ids
  34.         (append
  35.          current-ids
  36.          (list (list (mac#getmenu 134)
  37.                      "Special"
  38.                      (list (list #f "Load..." do-load-file)
  39.                            (list #f "Compile..." do-compile-file)
  40.                            (list #f "Switch to other menu" $menufuns))))))
  41.   (set! current-subids #f)
  42. ;  (mac#setcursor 1)
  43.   (mac#drawmenubar))
  44.  
  45. (mac#appendmenu (mac#getmenu 134) "Switch to other menu")
  46.  
  47. (set! mac#menuselection do-men-selection)
  48.  
  49. (define (burp item)
  50.   (format #t "File Menu pick item #~s~%" item))
  51.  
  52. (define (hiccup item)
  53.   (format #t "Edit Menu pick item #~s~%" item))
  54.  
  55. (define (submenpic item)
  56.   (format #t "Submenu pick item #~s~%" item))
  57.  
  58. (define (nada item) #t)
  59.  
  60. (define (nuke-menus dummy)
  61.   (let ((menid 0) (submenid 0))
  62.     (mac#clearmenubar)
  63.     (set! current-ids #f)
  64.     (add-old-menu "Apple" 128)            ;item 0
  65.     ;  (add-old-menu "File" 129)             ;item 1
  66.     (set! menid (add-new-menu "File"))
  67.     ;  (format #t "Menu id = ~s~%" menid)
  68.     (add-menu-item menid "New" burp "N" #f #f)
  69.     (disable-menitem menid 1)
  70.     (add-menu-item menid "Open" burp "O" #f #f)
  71. ;    (disable-menitem menid 2)
  72.     (add-menu-item menid "Import" burp "I" #f #f)
  73.     (add-menu-item menid "Close" burp "W" #f #f)
  74.     (add-menu-item menid "Save" burp "S" #f #t)
  75.     (add-menu-item menid "Save As..." burp #f #f #f)
  76.     (add-menu-item menid "Quit" restore-menus "Q" #f #t)
  77.     (set! menid (add-new-menu "Edit"))             ;item 2
  78.     ;  (format #t "Menu id = ~s~%" menid)
  79.     (add-menu-item menid "Cut" hiccup "X" #f #f)
  80.     (add-menu-item menid "Copy" hiccup "C" #f #f)
  81.     (add-menu-item menid "Paste" hiccup "V" #f #f)
  82.     (add-menu-item menid "Delete" hiccup "D" #f #f)
  83.     (add-menu-item menid "Select All" nada "A" #f #f)
  84.     (add-menu-item menid "Clear" hiccup #f #f #f)
  85.     (add-menu-item menid "Undo" (lambda (foo) (format #t "UNDOOOO~%")) "Z" #f #f)
  86.     (set! menid (add-new-menu "Submenus"))  ;item 3
  87.     (set! submenid (add-menu-item menid "First Pick" nada #f #t #f))
  88.     (add-submenu-item menid submenid "Sub1" submenpic)
  89.     (add-submenu-item menid submenid "Sub2" submenpic)))
  90.  
  91. (set! $menufuns nuke-menus)
  92. (restore-menus 3)
  93.  
  94.  
  95. ;;;And now for a completely different format...
  96. ;;;There is hidden in the bowels of MacGambit a ##format but
  97. ;;;it always writes to a port and won't write formatted numbers,
  98. ;;;so here is (format port format-string [restargs]).
  99. ;;;port is either an output-port (returned from open-output-file)
  100. ;;;or #t, whence it prints to your MacGambit Interaction window.
  101. ;;;The format string looks suspiciously like the format string used
  102. ;;;in Common Lisp, only with a serious lobotomy, or two
  103. ;;;the special characters are:
  104. ;;;  ~a - display an object (no quotes around strings, etc.)
  105. ;;;  ~s - write an object (strings have quotes)
  106. ;;;  ~d - write a decimal number
  107. ;;;  ~% - force a new line
  108. ;;;  ~i - where i is 1 to 9 - write a fixed-length number where
  109. ;;;       i is the number of places to write, left justified
  110. ;;;       (i.e., decimals are truncated)
  111. ;;;[restargs] is of course the arguments to be printed according
  112. ;;;to the format string.
  113. ;;;
  114. ;;;error handling is minimal, due to the double lobotomy - one
  115. ;;;perennial favorite error is not supplying a port (I know it's
  116. ;;;my favorite).  Another error which is not handled helpfully is
  117. ;;;that of not having the number of restargs match the number of
  118. ;;;expected arguments in the format string.
  119.  
  120. (format #t "Now is the time...~%")
  121. (format #t "you have now been running ~a seconds~%" (truncate (/ (mac#tickcount) 60)))
  122. (format #t "That's ~5 hours~%" (exact->inexact (/ (mac#tickcount) 60 3600)))